{-# OPTIONS -fglasgow-exts #-}
-----------------------------------------------------------------------------
-- |
-- Maintainer  :  joost.visser@di.uminho.pt, alcino@di.uminho.pt
-- Stability   :  experimental
-- Portability :  portable
--
-- Example of format evolution and data mapping, using a datatype
-- for music albums.
--
-----------------------------------------------------------------------------

module Data.Transform.TwoLevelAlbumTransformationHUnit where

import Data.Transform.Coupled
import Data.List as List
import HUnit
-----------------------------------------------------------------------------
main = runTestTT . TestCase $ testHierarchicalTransformation



-----------------------------------------------------------------------------
-- * Set up the format and some data

-- | The album format, encoded in Haskell.
albumFormat :: Type (String, (String, (String, Either () ())))
albumFormat
 = Tag "Album" (
       Prod (Tag "ASIN" String) (
       Prod (Tag "Title" String) (
       Prod (Tag "Artist" String) 
            (Tag "Format" (Either (Tag "LP" One) (Tag "CD" One))))))
            
-- | Example album: Abbey Road by The Beatles.
lp ::(String, (String, (String, Either () ())))
lp = ("B000002UB2",("Abbey Road",("The Beatles",Left ())))
  where _ = constrain albumFormat lp

-- | Example album: Debut by Bjork.
cd :: (String, (String, (String, Either () ())))
cd = ("B000002HCO",("Debut",("Bjork", Right ())))
  where _ = constrain albumFormat cd

-----------------------------------------------------------------------------
-- * Format evolution

-- | Add an alternative: format can now also be DVD.
addDvd = once (inside "Format" (addalt (Tag "DVD" One)))

-- | Adding a field: track list retrieved from some data source.
addTracks = once (inside "Album" (addinfo (List (Tag "Title" String)) aux))
   where aux :: Query [String]
         aux (Prod (Tag "ASIN" String) _) = FUN "query" (\(asin,_) -> graceNote asin)
         aux _ = FUN "query" (\ _ -> [])



-- | Looking up track listings from a database such as GraceNote.
graceNote :: String -> [String]
graceNote asin = maybe [] id $ List.lookup asin db
  where
    db = [ ("B000002UB2",
            ["Come Together","Something","Maxwell's Silver Hammer",
             "Oh! Darling","Octopus's Garden","I Want You (She's So Heavy)",
             "Here Comes the Sun","Because","You Never Give Me Your Money",
             "Sun King","Mean Mr. Mustard","Polythene Pam",
             "She Came in Through the Bathroom Window","Golden Slumbers",
             "Carry That Weight","End","Her Majesty"])
         , ("B000002HCO",
            ["Human Behaviour","Crying","Venus As A Boy",
             "There's More To Life Than This - Recorded Live At The Milk Bar Toilets",
             "Like Someone In Love","Big Time Sensuality","One Day","Aeroplane",
             "Come To Me","Violently Happy","The Anchor Song"
            ])
         ]

-----------------------------------------------------------------------------
-- * Test run

testHierarchicalTransformation::IO()
testHierarchicalTransformation = do
  putStrLn ">>> START Hierarchical Transformation TEST <<<"

 -- Running the type-level data mapping on both hierarchical formats.
  let toRDB = once enum2int >>> removetags >>> flatten
  let (Just vw0) = toRDB (List albumFormat)
  putStrLn $ snip $ showType vw0
  let (Just vw1) = toRDB (List intendedTargetFormat)
  putStrLn $ snip $ showType vw1
  assertEqual "Type-level data mapping FAILED 0" (show intendedTargetDBS0) (showType vw0)
  assertEqual "Type-level data mapping FAILED 1" (show intendedTargetDBS1) (showType vw1) 

  -- Running the forward value-level data mapping on two albums.
  let (Just db) = forth vw0 intendedTargetDBS0 [lp,cd]
  putStrLn $ snip $ show db
  assertString (show db)

  -- Migrate from and old database to an update one.
  let (Just lvw) = (addTracks >>> addDvd) (List albumFormat)
  let (Just x) = back vw0 intendedTargetDBS0 db 
  let (Just y) = forth lvw (List intendedTargetFormat) x
  let (Just z) = forth vw1 intendedTargetDBS1 y
  putStrLn $ snip $ show z
  assertString (show z)
 
  putStrLn ">>> Hierarchical Transformation TEST SUCCESSFUL <<<"




snip :: String -> String
snip x = "  "++(take 45 x)++" ... "++(takeLast 25 x)
  where
    takeLast n = reverse . (take n) . reverse
     
--targetLP = (("B000002UB2",("Abbey Road",("The Beatles",Left (Left ())))),["Come Together","Something","Maxwell's Silver Hammer","Oh! Darling","Octopus's Garden","I Want You (She's So Heavy)","Here Comes the Sun","Because","You Never Give Me Your Money","Sun King","Mean Mr. Mustard","Polythene Pam","She Came in Through the Bathroom Window","Golden Slumbers","Carry That Weight","End","Her Majesty"])
             
intendedTargetFormat = Tag "Album" (Prod (Prod (Tag "ASIN" String) (Prod (Tag "Title" String) (Prod (Tag "Artist" String) (Tag "Format" (Either (Either (Tag "LP" One) (Tag "CD" One)) (Tag "DVD" One)))))) (List (Tag "Title" String)))

intendedTargetDBS0 = Map Int (Prod String (Prod String (Prod String Int)))

intendedTargetDBS1 = (Prod (Map Int (Prod String (Prod String (Prod String Int)))) (Map (Prod Int Int) String))

-----------------------------------------------------------------------------

{-testFix = do
  let empF = (K String) :*: (List :@: Id)
  let emp0 = Pair (Const "Bill") (Comp [])
  let emp1 = ("Bill",[])
  putStrLn "oi"-}
